home *** CD-ROM | disk | FTP | other *** search
/ PC-X 1997 October / pcx14_9710.iso / swag / delphi.swg / 0205_Components: NewSpeedbutton.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1996-11-29  |  3.6 KB  |  178 lines
  1. {
  2.   DELPHI 1.0
  3.  
  4.   Two new freeware components based on TSpeedButton and TBitBtn.  The most
  5.   improvement is the ability to put an Icon replacing the only BMP picture.
  6.  
  7.   On somes ICON,  the result  is not  very good  but in the most case, the
  8.   result is great.
  9.  
  10.  
  11.   TAVCSpeedButton:
  12.  
  13.       - PopupMenu Feature
  14.       - Icon
  15.  
  16.   TBitBtn:
  17.  
  18.       - Icon
  19.  
  20.  
  21.    Sample:
  22.    ------
  23.  
  24.    var
  25.       btTry: TAVCSpeedButton;
  26.  
  27.    ...
  28.  
  29.       btTry.LoadIcon (LoadIcon(hInstance, 'MAINICON'));
  30.  
  31.  
  32.                ╔════════════════════════════════════════╗
  33.                ║                                        ║░
  34.                ║          AVONTURE CHRISTOPHE           ║░
  35.                ║              AVC SOFTWARE              ║░
  36.                ║     BOULEVARD EDMOND MACHTENS 157/53   ║░
  37.                ║           B-1080 BRUXELLES             ║░
  38.                ║              BELGIQUE                  ║░
  39.                ║                                        ║░
  40.                ╚════════════════════════════════════════╝░
  41.                ░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░
  42.  
  43.  
  44. }
  45. unit Icobtn;
  46.  
  47. interface
  48.  
  49. uses
  50.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  51.   Forms, Dialogs, Buttons, Extctrls, Menus;
  52.  
  53. type
  54.  
  55.   TAVCSpeedButton = class(TSpeedButton)
  56.   private
  57.     procedure WM_RBUTTONDOWN (var Message: TMessage); message WM_RBUTTONDOWN;
  58.   public
  59.     constructor Create(Owner: TComponent); override;
  60.     destructor  Destroy; override;
  61.     procedure   LoadIcon(Ico: hIcon);
  62.   published
  63.     PopupMenu : TPopupMenu;
  64.   end;
  65.  
  66.   TAVCBitBtn = class(TBitBtn)
  67.   protected
  68.   public
  69.     constructor Create(Owner: TComponent); override;
  70.     destructor  Destroy; override;
  71.     procedure   LoadIcon(Ico: hIcon);
  72.   published
  73.   end;
  74.  
  75. procedure Register;
  76.  
  77. implementation
  78.  
  79. Uses ShellAPI;
  80.  
  81. constructor TAVCBitBtn.Create;
  82. begin
  83.   inherited Create(Owner);
  84.   Parent := (Owner as TWinControl);
  85. end;
  86.  
  87. destructor TAVCBitBtn.Destroy;
  88. begin
  89.   inherited Destroy;
  90. end;
  91.  
  92. procedure TAVCBitBtn.LoadIcon;
  93. var
  94.    pic : TPicture;
  95.    iico : TIcon;
  96. begin
  97.  
  98.    iico        := TIcon.Create;
  99.    iico.Handle := ico;
  100.    Pic         := TPicture.Create;
  101.    Pic.Icon    := iico;
  102.    Glyph       := TBitmap.Create;
  103.    Height      := iico.Height+8;
  104.  
  105.    WITH Glyph DO
  106.       BEGIN
  107.          Width  := iico.Width+30;
  108.          Height := iico.Height;
  109.          Canvas.Draw (0, 0, Pic.Icon);
  110.       END;
  111.  
  112.    iico.free;
  113.  
  114. end;
  115.  
  116. { ******************************************************** }
  117.  
  118. constructor TAVCSpeedButton.Create;
  119. begin
  120.   inherited Create(Owner);
  121.   Parent := (Owner as TWinControl);
  122. end;
  123.  
  124. destructor TAVCSpeedButton.Destroy;
  125. begin
  126.   inherited Destroy;
  127. end;
  128.  
  129. procedure TAVCSpeedButton.LoadIcon;
  130. var
  131.    pic : TPicture;
  132.    iico : TIcon;
  133. begin
  134.  
  135.    iico        := TIcon.Create;
  136.    iico.Handle := ico;
  137.    Pic         := TPicture.Create;
  138.    Pic.Icon    := iico;
  139.    Glyph       := TBitmap.Create;
  140.    Height      := iico.Height+4;
  141.    Width       := iico.width+4;
  142.  
  143.    WITH Glyph DO
  144.       BEGIN
  145.          Width  := iico.Width;
  146.          Height := iico.Height;
  147.          Canvas.Draw (0, 0, Pic.Icon);
  148.       END;
  149.  
  150.    iico.free;
  151.  
  152. end;
  153.  
  154. procedure TAVCSpeedButton.WM_RBUTTONDOWN;
  155. var
  156.    Where: TPoint;
  157. begin
  158.  
  159.    IF NOT (PopupMenu = NIL) THEN
  160.       BEGIN
  161.          GetCursorPos (Where);
  162.          WITH PopupMenu DO
  163.             BEGIN
  164.                PopupComponent := TComponent(Self);
  165.                Popup (Where.X, Where.Y);
  166.             END;
  167.       END;
  168.  
  169. end;
  170.  
  171. procedure Register;
  172. begin
  173.    RegisterComponents ('Samples', [TAVCBitBtn]);
  174.    RegisterComponents ('Samples', [TAVCSpeedButton]);
  175. end;
  176.  
  177. end.
  178.